RSY-MC1

Mini-Challenge Beschreibung

Daten und Libraries

library(tidyverse)

Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ───────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.2 ──✔ ggplot2 3.4.0      ✔ purrr   0.3.5 
✔ tibble  3.1.8      ✔ dplyr   1.0.10
✔ tidyr   1.2.1      ✔ stringr 1.5.0 
✔ readr   2.1.3      ✔ forcats 0.5.2 ── Conflicts ──────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(recommenderlab)

Loading required package: Matrix

Attaching package: ‘Matrix’

The following objects are masked from ‘package:tidyr’:

    expand, pack, unpack

Loading required package: arules

Attaching package: ‘arules’

The following object is masked from ‘package:dplyr’:

    recode

The following objects are masked from ‘package:base’:

    abbreviate, write

Loading required package: proxy

Attaching package: ‘proxy’

The following object is masked from ‘package:Matrix’:

    as.matrix

The following objects are masked from ‘package:stats’:

    as.dist, dist

The following object is masked from ‘package:base’:

    as.matrix

Loading required package: registry

library(gridExtra)

Attaching package: ‘gridExtra’

The following object is masked from ‘package:dplyr’:

    combine

Daten einlesen

data(MovieLense)

Beim Einlesen des Datensatzes werden drei realRatingMatrix eingelesen: MovieLense, MovieLenseMeta und MovieLenseUser. Wir untersuchen nun zuerst MovieLense.

Library Methoden zum Datensatz MovieLense

methods(class = class(MovieLense))

 [1] [                      [<-                    binarize               calcPredictionAccuracy coerce                 colCounts             
 [7] colMeans               colSds                 colSums                denormalize            dim                    dimnames              
[13] dimnames<-             dissimilarity          evaluationScheme       getData.frame          getList                getNormalize          
[19] getRatingMatrix        getRatings             getTopNLists           hasRating              image                  normalize             
[25] nratings               Recommender            removeKnownRatings     rowCounts              rowMeans               rowSds                
[31] rowSums                sample                 show                   similarity            
see '?methods' for accessing help and source code

Diese Übersicht zeigt uns, welche Methoden mit der realRatingMatrix in Kombination mit Recommenderlab möglich sind.

MovieLense Dataframe erstellen

MovieLenseEDA <- as(MovieLense, "data.frame")

Um den EDA-Teil lösen zu können, haben wir die realRatingMatrix in einen data.frame umgewandelt.

Kopfzeile und Fusszeile vom Datensatz ausgeben

head(MovieLenseEDA)

tail(MovieLenseEDA)

Um eine Idee der Daten zu erhalten, haben wir den Head und Tail des Dataframes ausgegeben. Es wird ersichtlich, dass für jede Zeile ein User, Item (Film) und das Rating erfasst sind.

Infos zum Datensatz

summary(MovieLenseEDA)

     user               item               rating    
 Length:99392       Length:99392       Min.   :1.00  
 Class :character   Class :character   1st Qu.:3.00  
 Mode  :character   Mode  :character   Median :4.00  
                                       Mean   :3.53  
                                       3rd Qu.:4.00  
                                       Max.   :5.00  

Mit der Summary Funktion haben wir uns einen Überblick über die Zahlen im Datensatz erschaffen. Es sind jeweils 99’392 User und Items erfasst. Die Ratings reichen vom Bereich 1 bis 5 und der Mittelwert beträgt 3.53 (Median 4.0)

1 Explorative Datenanalyse

Aufgabe 1: Untersuche den vollständigen MovieLense Datensatz (d.h. vor Datenreduktion!) und beantworte folgende Fragen:

1.1 Welches sind die am häufigsten geschauten Genres/Filme?

1.1.1 Welches sind die am häufigsten geschauten Filme?

MovieLenseEDA %>% 
  group_by(item) %>% 
  summarise(Anzahl = n()) %>%
  arrange(desc(Anzahl)) %>% 
  head(n=10)

Diese Tabelle zeigt uns die Top-10 der am meisten geschauten, resp. gerateten Filme. Es wird ersichtlich, dass Star Wars (1977, vermutlich “Krieg der Sterne”) 583 mal geschaut und geratet wurde.

1.1.2 Welches sind die am häufigsten geschauten Genre?

# Full Join mit df_movies_rating und MovieLenseMeta
MovieLenseEDA_Joined <- full_join(MovieLenseEDA, MovieLenseMeta, 
          by = c("item" = "title")) %>% 
  select(-c("user", "item", "rating", "year", "url")) 

# Aufsummieren der Genre Spalten
(colSums(MovieLenseEDA_Joined)) %>% sort(decreasing = TRUE)

      Drama      Comedy      Action    Thriller     Romance   Adventure      Sci-Fi         War       Crime  Children's      Horror     Mystery 
      39446       29778       25510       21808       19203       13688       12694        9398        8027        7143        5280        5237 
    Musical   Animation     Western   Film-Noir     Fantasy Documentary     unknown 
       4954        3605        1854        1733        1352         758          10 

Wir erkennen, dass das am häufigsten geschauten Genre “Drama” mit 39’446 Ratings ist. Auf dem zweiten Platz befindet sich “Comdey” und auf dem dritten “Action”. Am wenigsten häufig wurden “Documentary” und “unknown” geschaut.

1.2 Wie verteilen sich die Kundenratings gesamthaft und nach Genres?

# DataFrame join
MovieLenseEDA_Joined <- full_join(MovieLenseEDA, MovieLenseMeta, 
          by = c("item" = "title"))

Für diese Frage haben wir einen neuen Datensatz “MovieLenseEDA_Joined” erstellt. Er ergibt sich aus MovieLenseEDA und MovieLenseMeta. Folgend nun die Beantwortund der Frage.

1.2.1 Verteilung der Kundenratings Gesamthaft

MovieLenseEDA_Joined$rating <- as.factor(MovieLenseEDA_Joined$rating)

# Dataframe Uebersicht
MovieLenseEDA_Joined %>% group_by(rating) %>%
  summarize(Anzahl = n())

# Visuelle Darstellung mittels Barplot
MovieLenseEDA_Joined %>% group_by(rating) %>%
  summarize(Anzahl = n()) %>% 
  ggplot(aes(x = rating, y = Anzahl)) + 
  geom_bar(stat = "identity", 
           fill = "lightblue", 
           color = "black") + 
  labs(x = "Ratings", 
       y = "Anzahl", 
       title = "Verteilung der Kundenratings Gesamthaft",
       subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA_Joined)[1]))

Wie wir in im Dataframe sowie im Barplot erkennen, werden am häufigsten die Ratings 3 und 4 vergeben. Rating von 1 und 2 kommen deutlich weniger vor, als möglicher Grund könnte sein, dass Filme die schlecht sind gar nicht bewertet wurden, da man sich nicht mehr weiter mit schlechten Filmen befassen möchte. Aus eigenen Erfahrungen können wir sagen, dass man eher mehr bereit ist einen Film zu bewerten, wenn diese auch wirklich gut ist. Das Rating 5 kommt am dritthäufigsten vor.

1.2.2 Verteilung der Kundenratings nach Genre

MovieLenseEDA_Joined$rating <- as.integer(MovieLenseEDA_Joined$rating)

MovieLenseEDA_Joined %>% 
  select(-c("item", "user", "year", "url")) %>% 
  pivot_longer(cols=c("unknown", "Action", "Adventure", "Animation", "Children's",
                      "Comedy", "Crime", "Documentary", "Drama", "Fantasy",
                      "Film-Noir", "Horror", "Musical", "Mystery", "Horror",
                      "Musical", "Mystery", "Romance", "Sci-Fi", "Thriller",
                      "War", "Western"),
               names_to = "Genre", values_to = "is_genre") %>%
  filter(is_genre == 1) %>% 
  ggplot(aes(x = rating)) +
  geom_bar(fill = "lightblue", color = "black") +
  labs(x = "Ratings", 
       y = "Anzahl", 
       title = "Verteilung der Kundenratings nach Genre",
       subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA_Joined)[1])) + 
  facet_wrap(~Genre)

In der Visualisierung der Verteilung der Kundenratings pro Genre erkennen wir analog, wie bei der Verteilung der gesamthaften Kundenratings, dass die Rating 3 und 4 am meisten vergeben werden. Dieses Muster ist bei fast allen Genres erkennbar, einfach mit unterschiedlicher Intensität (Anzahl Ratings).

1.3 Wie verteilen sich die mittleren Kundenratings pro Film?

# Dataframe
MovieLenseEDA %>% 
  group_by(item) %>% 
  summarize(mean_rating_per_film = mean(rating),
            n_rating_per_film = n()) %>% 
  arrange(n_rating_per_film)

# Visualisierung
MovieLenseEDA %>% 
  group_by(item) %>% 
  summarize(mean_rating_per_film = mean(rating)) %>% 
  ggplot(aes(x = mean_rating_per_film)) + 
  geom_histogram(color = "black", fill = "lightblue", binwidth = 0.1) +
    labs(x = "Ratings", 
       y = "Anzahl", 
       title = "Verteilung der Mittleren Kundenratings pro Film",
       subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA)[1]))

Wir erkennen im Plot die Verteilung durchschnittliche Rating pro Film. Auch hier ist erkennbar, dass die meisten Ratings zwischen 3 und 4 liegen. Einen Ausreisser gibt es beim Rating 1. Bei den natürlichen/ganzzähligen Zahlen erkennen wir ein überraschendes Muster: Die Anzahl erscheint jeweils höher als bei den umliegenden Ratings mit Kommastellen. Dies liegt daran, dass es Filme gibt die nur eine oder wenige Bewertungen bekommen haben (siehe ausgegebenes Datafarme).

1.4 Wie stark streuen die Ratings von individuellen Kunden?

MovieLenseEDA %>% filter(user == c(1:9)) %>% 
  ggplot(aes(x = user, y = rating)) +
  geom_violin(color = "black", fill = "lightblue") +
  labs(x = "User", 
       y = "Ratings", 
       title = "Streueung der Ratings von individuellen Kunden",
       subtitle = "MovieLenseData, Kunden 1-9")

Im Violinenplot stellen wir die ersten 9 User und deren Rating Verteilungen dar. Wir erkennen im Plot, dass User 2 und 8 Filme sehr ähnliche bewerten. Beide bewerten Filme öfters mit einer 4 und eher weniger eine 3 und 5, aber nie 2 und 1. User 5 und 9 bewerten Filme hingegen im ganzen Bereich.

1.5 Welchen Einfluss hat die Normierung der Ratings pro Kunde auf deren Verteilung?

MovieLensenormalized <- normalize(MovieLense)
MovieLenseEDA_Normalized <- (as(MovieLensenormalized, "data.frame"))

MovieLenseEDA_Normalized %>% filter(user == c(1:9)) %>% 
  ggplot(aes(x = user, y = rating)) +
  geom_violin(color = "black", fill = "lightblue") +
  labs(x = "User", 
       y = "Normalisierte Ratings", 
       title = "Normalisierte Streueung der Ratings von individuellen Kunden",
       subtitle = "MovieLenseData, Kunden 1 - 9")

Für die Normierung der Daten haben wir die Funktion von Recommenderlab verwendet. Der Mittelwert der Ratings pro User beträgt nun Null. Im Plot verschiebt sich nun nicht nur die y-Achse, sondern auch die Bandbreite. user 5 und 9, die auf den Rohdaten 1-5 bewertet haben, haben nun unterschiedliche Bandbreiten. Dies liegt daran, dass der Mittelwert der beiden User unterschiedlich ist.

1.6 Welche strukturellen Charakteristika (z.B. Sparsity) und Auffälligkeiten zeigt die User-Item Matrix?

image(x = MovieLense, 
      xlab = "Items", 
      ylab = "Users", 
      main = "Sparisty 943 x 1664 User-Item Matrix 943 x 1664") 

image(MovieLense[1:50,1:50],
      xlab = "Items",
      ylab = "Users", 
      main = "Sparisty 50 x 50 User-Item Matrix")

# nratings(MovieLense) zaehlt die Anzahl vorhandenen Kombinationen von User und Items
(nratings(MovieLense) / (dim(MovieLense)[1] * dim(MovieLense)[2]) * 100)

[1] 6.334122

Für die Darstellung der Sparsity haben wir die image Funktion von Recommenderlab verwendet. Jede Zeile von MovieLense entspricht einem Benutzer und jede Spalte einem Film und für jede geschaute Kombination wird ein Pixel in Graustufen, je nach Rating, markiert. Im ersten Plot wird ersichtlich, dass die ersten User weniger Filme bewertet haben, denn oben rechts sind keine Punkte mehr ersichtlich. Auch ist auffällig, dass die ersten etwa 500 häufiger geschaut wurden, denn bis zu diesem Bereich sind am meisten Pixel eingefärbt. Um die Darstellung genau verstehen zu können, haben wir im zweiten Plot nur die ersten 50 User und Items dargestellt. Dort ist die hohe Sparsity gut erkennbar. Gesamthaft gibt es 943 x 1664 = 1’569’152 Kombinationen zwischen User und Film. Allerdings hat nicht jeder Nutzer jeden Film gesehen, aus diesem Grund ist es wichtig die sparsity der Matrix zu betrachten. In MovieLense Matrix fehlen ca. 94% der Kombinationen. Nur für 6.3% der möglichen Kombinationen sind Ratings vorhanden.

2 Datenreduktion

Aufgabe 2: Reduziere den MovieLense Datensatz auf rund 400 Kunden und 700 Filme, indem du Filme und Kunden mit sehr wenigen Ratings entfernst.

2.1 Vorbereitung

2.1.1 DataFrame neu einlesen

MovieLenseToCut <- as(MovieLense, "data.frame")
MovieLenseToCut

2.1.2 Auswahl der 400 Kunden

select_user_400 <- function(movie_df, start, end) {
  selected_user <- movie_df %>% 
    group_by(user) %>% 
    summarize(Anzahl = n()) %>% 
    arrange(desc(Anzahl)) %>% 
    slice(start:end)
  selected_user
}

MovieLense400User_1 <- select_user_400(MovieLenseToCut, 0, 400)
MovieLense400User_1

MovieLense400User_2 <- select_user_400(MovieLenseToCut, 200, 599)
MovieLense400User_2

Bei der Auswahl der 400 User haben wir direkt auch zwei Dataframes erstellt, da wir die MC zu zweit bearbeiten. Für Person 1 haben wir die 400 User mit den meisten Ratings ausgewählt und für Person 2 User 200 bis 600. Wir haben dieses Vorgehen gewählt um sicherzustellen, dass nur eine Teil der User in beiden Dataframes enthalten ist. Alternativ hätten wir von den Top 500 User zufällig 80% für Person 1 und 2 verwendet, dann hätte die Überlappung aber sehr hoch sein können, so ist es nur die Hälft.

2.1.3 Auswahl der 700 Movies

select_item_700 <- function(movie_df, start, end) {
  selected_item <- MovieLenseToCut %>% 
  group_by(item) %>% 
  summarise(Anzahl = n()) %>% 
  arrange(desc(Anzahl)) %>% 
  slice(start:end)
}

MovieLense700Items_1 <- select_item_700(MovieLenseToCut, 0, 700)
MovieLense700Items_1

MovieLense700Items_2 <- select_item_700(MovieLenseToCut, 150, 849)
MovieLense700Items_2

NA

Das gleiche Vorgehen haben wir bei den Filmen gewählt.

2.1.4 DataFrame schneiden

df_cutter <- function(movie_df, selected_user, selected_items) {
  movie_df_cut <- movie_df %>%
      filter(user %in% c(selected_user$user))
  movie_df_cut <- movie_df_cut %>% 
      filter(item %in% c(selected_items$item))
  movie_df_cut
}

MovieLenseCut_1 <- df_cutter(MovieLenseToCut, MovieLense400User_1, MovieLense700Items_1)
MovieLenseCut_1

MovieLenseCut_2 <- df_cutter(MovieLenseToCut, MovieLense400User_2, MovieLense700Items_2)
MovieLenseCut_2

Untersuche und dokumentiere die Eigenschaften des reduzierten Datensatzes und beschreibe den Effekt der Datenreduktion, d.h.

2.2 Anzahl Filme und Kunden sowie Sparsity vor und nach Datenreduktion,

2.2.1 Vor der Datenreduktion

image(MovieLense, 
      xlab = "Items", 
      ylab = "Users", 
      main = "Vor Datenreduktion, User-Item Matrix 943 x 1664") 

sparsity_text <- function(realrating_matrix) {
  print(paste("Anzahl vorhandene User-Item Rating in", nratings(realrating_matrix) / (dim(realrating_matrix)[1] * dim(realrating_matrix)[2]) * 100, "%"))
  print(paste("Sparsity der Matrix", 100 - (nratings(realrating_matrix) / (dim(realrating_matrix)[1] * dim(realrating_matrix)[2]) * 100), "%"))
}

sparsity_text(MovieLense)

[1] "Anzahl vorhandene User-Item Rating in 6.33412186964679 %"
[1] "Sparsity der Matrix 93.6658781303532 %"

Zur Repetition stellen wir nochmals die Sparsity als Bild dar und berechnen den Wert.

2.2.2 Nach der 1. Datenreduktion

MovieLenseCompact_1 <- as(MovieLenseCut_1, "realRatingMatrix")
image(MovieLenseCompact_1,
      xlab = "Items", 
      ylab = "Users", 
      main = "Nach Datenreduktion 1, User-Item Matrix 400 x 700")

sparsity_text(MovieLenseCompact_1)

[1] "Anzahl vorhandene User-Item Rating in 24.0810714285714 %"
[1] "Sparsity der Matrix 75.9189285714286 %"

Für den ersten Datensatz wird ersichtlich, dass die Ratings gegenüber dem ursprünglichen Datensatz gleichmässig verteilt sind. Vereinzelt sind für User (z.B. im Bereich 90-150) und Items (z.B Bereicht um 600) dunklere Bereiche erkennbar. In diesen dürften die Ratings höher und Sparsity geringer sein. Die Sparsity beträgt nun auch nur noch etwa 75% und für 25% der möglichen Kombinationen zwischen User und Item wurden Ratings angegeben.

Diese starke Änderung war aber zu erwarten, da wir die User und Items mit den meisten Ratings ausgewählt haben.

2.2.3 Nach der 2. Datenreduktion

MovieLenseCompact_2 <- as(MovieLenseCut_2, "realRatingMatrix")
image(MovieLenseCompact_2,
      xlab = "Items", 
      ylab = "Users", 
      main = "Nach Datenreduktion 2, User-Item Matrix 400 x 700")

sparsity_text(MovieLenseCompact_2)

[1] "Anzahl vorhandene User-Item Rating in 6.35142857142857 %"
[1] "Sparsity der Matrix 93.6485714285714 %"

Für den zweiten Datensatz wird ersichtlich, dass die Ratings gegenüber dem ursprünglichen Datensatz gleichmässig verteilt sind, gegenüber dem ersten Datensatz aber sichtbar weniger Ratings vorhanden sind. Dunklere Bereich, wie bei Datensatz1 sind kaum mehr zu erkennen. Die Sparsity beträgt liegt nun bei 93.6%, sie ist gegenüber dem ersten Datensatz also deutlich angestiegen, liegt aber bereits im Bereich des ursprünglichen Wertes. Dieser Anstieg war zu erwarten, da wir nicht mehr die User und Items mit den meisten Ratings ausgewählt haben, sondern z.B. bei den Usern bei Top 200 angefangen haben.

2.3 Mittlere Kundenratings pro Film vor und nach Datenreduktion,

mean_rating_per_film_viz <- function(movie_df) {
  movie_df %>% 
  group_by(item) %>% 
  summarize(mean_rating_per_film = mean(rating)) %>% 
  ggplot(aes(x = mean_rating_per_film)) + 
  geom_histogram(color = "black", fill = "lightblue", binwidth = 0.1) +
    labs(x = "Ratings", 
       y = "Anzahl", 
       title = "Mittlere Kundenratings Verteilung",
       subtitle = paste("Gesamte Anzahl Kundenratings:", dim(movie_df)[1])) +
    geom_vline(xintercept = mean(movie_df$rating), color = "red", linetype = "dashed", size = 0.5)
}
# Vor reduktion
print(mean_rating_per_film_viz(MovieLenseEDA))

Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
Please use `linewidth` instead.

# nach 1. Redutkion
print(mean_rating_per_film_viz(MovieLenseCut_1))

# nach 2. Reduktion
print(mean_rating_per_film_viz(MovieLenseCut_2))

Die erste Visualisierung zeigt den bereits bekannten Plot mit den mittleren Kundenratings für den gesamten Datensatz. Plot 2 und 3 zeigt die selbe Auswertung für die beiden gekürzten Datensätze. In den Visualisierungen erkennen wir, dass der Mittelwert der Kundenrating für den ursprünglichen, sowie auch für die beiden reduzierten Datensätze, nicht grossartig ändert. Die Mittelwerte befinden sich bei allen im Bereich von 3.5. Was aber erkennbar wird, ist, dass bei der 1. Reduktion die hohe Anzahl Rating bei den natürlichen/ganzzahligen Zahlen weggefallen ist. Weiterhin sind bei allen Visualisierungen erkennbar, dass die meisten Rating im Bereich von 3 bis 4 liegen.

2.4 Für Gruppen: Quantifiziere “Intersection over Union” der Ratings der unterschiedlich reduzierten Datensätze.

intersect_join <- inner_join(MovieLenseCut_1, MovieLenseCut_2, by = c("user", "item"))
intersect_join

union_join <- full_join(MovieLenseCut_1, MovieLenseCut_2, by = c("user", "item"))
union_join

paste("Eine Intersection over Union von", dim(intersect_join)[1] / dim(union_join)[1] * 100, "%, zwischen den beiden reduzierten Datensätzen")

[1] "Eine Intersection over Union von 15.5638434935919 %, zwischen den beiden reduzierten Datensätzen"

Zur Beantwortung dieser Frage haben wir einerseits einen Datensatz mit Daten, die in beiden Datensätzen vorhanden sind erstellt und diesen mit der gesamten Anzahl Daten verglichen. Es zeigt sich, dass es eine Überschneidung von 15.6% zwischen den beiden reduzierten Datensätzen gibt. Dieser eher tiefe Wert überrascht, weil z.B. 50% der User übereinstimmen. Aber aufgrund der hohen Sparsity ist die Überschneidung der Daten viel tiefer.

3 Analyse Ähnlichkeitsmatrix

Aufgabe 3: Erzeuge einen IBCF Recommender und analysiere die Ähnlichkeitsmatrix des trainierten Modelles für den reduzierten Datensatz.

3.1 Zerlege den reduzierten MovieLense Datensatz in ein disjunktes Trainings-und Testdatenset im Verhältnis 4:1,

train_test_split <- function(movie_df, split = 0.8) {
  n <- dim(movie_df)[1]
  n_train <- round(n * split)
  n_test <- n - n_train
  training <- movie_df[1:n_train]
  test <- movie_df[(n_train + 1):n]
  return(list(training, test))
}

train_test_list_1 <- train_test_split(MovieLenseCompact_1)
training_1 <- train_test_list_1[[1]]
test_1 <- train_test_list_1[[2]]
training_1

320 x 700 rating matrix of class ‘realRatingMatrix’ with 53971 ratings.

test_1

80 x 700 rating matrix of class ‘realRatingMatrix’ with 13456 ratings.

train_test_list_2 <- train_test_split(MovieLenseCompact_2)
training_2 <- train_test_list_2[[1]]
test_2 <- train_test_list_2[[2]]
training_2

320 x 700 rating matrix of class ‘realRatingMatrix’ with 14368 ratings.

test_2

80 x 700 rating matrix of class ‘realRatingMatrix’ with 3416 ratings.

Beide reduzierten Datensätze wurden im Verhältnis 4:1, (4 Teile Training und 1 Teil Test) reduziert.

3.2 Trainiere ein IBCF Modell mit 30 Nachbarn und Cosine Similarity

ribcf_1 <- Recommender(training_1, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_1

Recommender of type ‘IBCF’ for ‘realRatingMatrix’ 
learned using 320 users.

ribcf_2 <- Recommender(training_2, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_2

Recommender of type ‘IBCF’ for ‘realRatingMatrix’ 
learned using 320 users.

Es wurden jeweils für beide reduzierten Datensaetze ein IBCF Modell mit 30 Nachbarn und der Cosine Similarity mittels der von Recommenderlab zur Verfügung gestellten Methode trainiert. Die Auswertung bestätigt, dass das Training mittels 320 Usern, resp. 80% der ursprünglichen 400, durchgeführt wurde.

3.3 Bestimme die Verteilung der Filme, welche bei IBCF für paarweise Ähnlichkeitsvergleiche verwendet werden

ribcf_sim_item_df <- function(ribcf) {
  # model
  ribcf_model <- getModel(ribcf)
  # dataframe erstellen
  ribcf_sim_df <- as.data.frame(colSums(ribcf_model$sim > 0))
  # Item als neue Spalte hinzufuegen und Index entfernen
  ribcf_sim_df_ <- cbind(item = rownames(ribcf_sim_df), ribcf_sim_df)
  rownames(ribcf_sim_df_) <- NULL
  # return df
  ribcf_sim_df_
}

ribcf_sim_viz <- function(ribcf_sim_df_, n_reduc) {
    ribcf_sim_df_ %>%
    rename(Anzahl = 2) %>% 
    ggplot(aes(x = Anzahl)) + 
    geom_histogram(binwidth =  0.1) +
    labs(title = "Verteilung der Ähnlichkeitsvergleiche",
         x = "Anzahl Filme als Nachbar", 
         y = "Anzahl",
         subtitle = paste("ribcf", n_reduc))
}

ribcf_sim_df_1 <- ribcf_sim_item_df(ribcf_1)
ribcf_sim_viz(ribcf_sim_df_1, 1)

ribcf_sim_df_2 <- ribcf_sim_item_df(ribcf_2)
ribcf_sim_viz(ribcf_sim_df_2, 2)

NA
NA

Im Histogramm erkennt man die Anzahl Filme die als Nachbar bei einem anderen Film auftauchen. Beide Plots sind deutlich unterschiedlich

3.4 Bestimme die Filme, die am häufigsten in der Cosine-Ähnlichkeitsmatrix auftauchen und analysiere deren Vorkommen und Ratings im reduzierten Datensatz.

top_10_item_sim <- function(ribcf_sim_df_, n_reduc) {
  result <- ribcf_sim_df_ %>% 
  rename(Anzahl = 2) %>% 
  arrange(desc(Anzahl)) %>% 
  top_n(10)
    
  print(result)
    
  result %>%   
  ggplot(aes(x = Anzahl, y = item)) +
  # arrange desc
  geom_col(alpha = 0.5, color = "black", fill = "limegreen") +
  labs(title = "Top 10 Filme die am häufigsten in der Nachbarschaft andere Filme auftauchen",
       x = "Anzahl Film als Nachbar", 
       y = "Filme",
       subtitle = paste("ribcf", n_reduc))
}
  
top_10_item_sim(ribcf_sim_df_1, 1)

Selecting by Anzahl

top_10_item_sim(ribcf_sim_df_2, 2)

Selecting by Anzahl

Für jeden der beiden Datensätze haben wir einen Dataframe und Plot mit den Filmen, die am häufigsten in der Cosine-Ähnlichkeitsmatrix auftauchen, erstellt. Bei den top 10 Filmen sind keine Gemeinsamkeiten ersichtlich. Die Anzahl der Vorkommen ist aber ähnlich, der höchste Wert ist zwischen 150 und 160 und die Nummer 10 liegt bei 120 Vorkommen.

4 Implementierung Ähnlichkeitsmatrix

Aufgabe 4 (DIY): Implementiere eine Funktion zur effizienten Berechnung von sparsen Ähnlichkeitsmatrizen für IBCF RS und analysiere die Resultate für 100 zufällig gewählte Filme.

4.1 Implementiere eine Funktion, um (a) für ordinale Ratings effizient

die Cosine Similarity und (b) für binäre Ratings effizient die Jaccard Similarity zu berechnen,

number_user <- 100
number_item <- 100

Diese Variablen haben wir für die Entwicklung der Funktionen verwendet. Wir konnte damit einfach kleinere, z.B. 5, Datensätze slicen.

4.1.1 Cosine Similarity

get_cossim_4 <- function(RatingMatrix, n_user, n_item){
 
  sliced_matrix <- getRatingMatrix(RatingMatrix[1:n_user, 1:n_item])
  
  sliced_matrix_t <- t(sliced_matrix)
  
  temp_sim <- sliced_matrix_t / sqrt(rowSums(sliced_matrix_t ** 2))

  cossim_matrix <- temp_sim %*% t(temp_sim)

  cossim_matrix
}

result_cossim_4 <- get_cossim_4(MovieLense, number_user, number_item)
result_cossim_4[1:20,1:20]

20 x 20 sparse Matrix of class "dgCMatrix"

   [[ suppressing 20 column names ‘Toy Story (1995)’, ‘GoldenEye (1995)’, ‘Four Rooms (1995)’ ... ]]

                                                                                                                                               
Toy Story (1995)                                     1.0000000 0.3786054 0.3557149 0.4085792 0.35406521 0.2106625 0.6507823 0.5128509 0.4809693
GoldenEye (1995)                                     0.3786054 1.0000000 0.1595558 0.4058678 0.33981928 0.1078328 0.2498391 0.2921164 0.2701317
Four Rooms (1995)                                    0.3557149 0.1595558 1.0000000 0.3989039 0.22857516 0.2263010 0.3581228 0.2310704 0.2649610
Get Shorty (1995)                                    0.4085792 0.4058678 0.3989039 1.0000000 0.26745994 0.1328422 0.4245295 0.5445979 0.4781120
Copycat (1995)                                       0.3540652 0.3398193 0.2285752 0.2674599 1.00000000 0.1313064 0.3322003 0.2039381 0.4163740
Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2106625 0.1078328 0.2263010 0.1328422 0.13130643 1.0000000 0.2130495 0.1805984 0.2092867
Twelve Monkeys (1995)                                0.6507823 0.2498391 0.3581228 0.4245295 0.33220032 0.2130495 1.0000000 0.5179884 0.5991567
Babe (1995)                                          0.5128509 0.2921164 0.2310704 0.5445979 0.20393810 0.1805984 0.5179884 1.0000000 0.6064674
Dead Man Walking (1995)                              0.4809693 0.2701317 0.2649610 0.4781120 0.41637401 0.2092867 0.5991567 0.6064674 1.0000000
Richard III (1995)                                   0.2412952 0.1873510 0.3780578 0.2820925 0.07604487 0.4311379 0.2699059 0.3242348 0.3275021
Seven (Se7en) (1995)                                 0.4553382 0.1632439 0.3843138 0.5195206 0.36995125 0.1093345 0.5694625 0.5399670 0.5360525
Usual Suspects, The (1995)                           0.4651021 0.3486586 0.3794973 0.6074053 0.39453741 0.2776088 0.5844860 0.5715472 0.6633322
Mighty Aphrodite (1995)                              0.5220124 0.2496832 0.3871603 0.3777443 0.19202253 0.3006045 0.5160271 0.4357768 0.4985081
Postino, Il (1994)                                   0.4588155 0.1724141 0.4344255 0.2698077 0.15320397 0.4191717 0.3159025 0.4495279 0.4480904
Mr. Holland's Opus (1995)                            0.6120818 0.2968567 0.3117847 0.3590970 0.39631951 0.1791067 0.5034813 0.3576072 0.5884584
French Twist (Gazon maudit) (1995)                   0.2202742 0.2062550 0.3329636 0.2625611 0.25115377 0.3187884 0.1833778 0.0345436 0.2486767
From Dusk Till Dawn (1996)                           0.3199297 0.3785939 0.2558409 0.3633585 0.32163376 0.2531139 0.2413614 0.2963905 0.3417637
White Balloon, The (1995)                            0.1396962 0.1479453 0.4776651 0.2126344 0.18015094 0.3658636 0.2192261 0.1176950 0.3480472
Antonia's Line (1995)                                0.2946435 0.1047364 0.1690792 0.1032222 0.12753608 0.4662172 0.3078112 0.2350530 0.2710362
Angels and Insects (1995)                            0.1891240 0.1290770 0.4427924 0.1855159 0.15717527 0.4488792 0.1593891 0.2594140 0.3226374
                                                                                                                                                
Toy Story (1995)                                     0.24129522 0.45533821 0.4651021 0.5220124 0.4588155 0.6120818 0.2202742 0.3199297 0.1396962
GoldenEye (1995)                                     0.18735098 0.16324390 0.3486586 0.2496832 0.1724141 0.2968567 0.2062550 0.3785939 0.1479453
Four Rooms (1995)                                    0.37805783 0.38431384 0.3794973 0.3871603 0.4344255 0.3117847 0.3329636 0.2558409 0.4776651
Get Shorty (1995)                                    0.28209250 0.51952065 0.6074053 0.3777443 0.2698077 0.3590970 0.2625611 0.3633585 0.2126344
Copycat (1995)                                       0.07604487 0.36995125 0.3945374 0.1920225 0.1532040 0.3963195 0.2511538 0.3216338 0.1801509
Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.43113793 0.10933445 0.2776088 0.3006045 0.4191717 0.1791067 0.3187884 0.2531139 0.3658636
Twelve Monkeys (1995)                                0.26990593 0.56946246 0.5844860 0.5160271 0.3159025 0.5034813 0.1833778 0.2413614 0.2192261
Babe (1995)                                          0.32423475 0.53996700 0.5715472 0.4357768 0.4495279 0.3576072 0.0345436 0.2963905 0.1176950
Dead Man Walking (1995)                              0.32750209 0.53605254 0.6633322 0.4985081 0.4480904 0.5884584 0.2486767 0.3417637 0.3480472
Richard III (1995)                                   1.00000000 0.35313083 0.3688357 0.3724946 0.4171123 0.1504695 0.1846233 0.3940552 0.4745374
Seven (Se7en) (1995)                                 0.35313083 1.00000000 0.6427527 0.2562351 0.2316937 0.3159148 0.2091273 0.3399173 0.2884724
Usual Suspects, The (1995)                           0.36883567 0.64275270 1.0000000 0.4417965 0.3831814 0.4257209 0.2811128 0.3440000 0.3920784
Mighty Aphrodite (1995)                              0.37249460 0.25623511 0.4417965 1.0000000 0.5845588 0.4709003 0.2874876 0.1293548 0.3692327
Postino, Il (1994)                                   0.41711226 0.23169366 0.3831814 0.5845588 1.0000000 0.4880400 0.2066398 0.2381653 0.5039526
Mr. Holland's Opus (1995)                            0.15046955 0.31591479 0.4257209 0.4709003 0.4880400 1.0000000 0.1586031 0.1868622 0.3185419
French Twist (Gazon maudit) (1995)                   0.18462325 0.20912731 0.2811128 0.2874876 0.2066398 0.1586031 1.0000000 0.2342606 0.4373740
From Dusk Till Dawn (1996)                           0.39405520 0.33991729 0.3440000 0.1293548 0.2381653 0.1868622 0.2342606 1.0000000 0.3360672
White Balloon, The (1995)                            0.47453738 0.28847237 0.3920784 0.3692327 0.5039526 0.3185419 0.4373740 0.3360672 1.0000000
Antonia's Line (1995)                                0.38125745 0.08985732 0.3045318 0.5365988 0.4952783 0.3028259 0.3096346 0.2141239 0.4886175
Angels and Insects (1995)                            0.42364525 0.18246935 0.2980934 0.3282205 0.5172714 0.2431769 0.3815932 0.3420744 0.5303215
                                                                         
Toy Story (1995)                                     0.29464348 0.1891240
GoldenEye (1995)                                     0.10473645 0.1290770
Four Rooms (1995)                                    0.16907917 0.4427924
Get Shorty (1995)                                    0.10322223 0.1855159
Copycat (1995)                                       0.12753608 0.1571753
Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.46621721 0.4488792
Twelve Monkeys (1995)                                0.30781124 0.1593891
Babe (1995)                                          0.23505300 0.2594140
Dead Man Walking (1995)                              0.27103623 0.3226374
Richard III (1995)                                   0.38125745 0.4236452
Seven (Se7en) (1995)                                 0.08985732 0.1824693
Usual Suspects, The (1995)                           0.30453181 0.2980934
Mighty Aphrodite (1995)                              0.53659876 0.3282205
Postino, Il (1994)                                   0.49527834 0.5172714
Mr. Holland's Opus (1995)                            0.30282587 0.2431769
French Twist (Gazon maudit) (1995)                   0.30963462 0.3815932
From Dusk Till Dawn (1996)                           0.21412393 0.3420744
White Balloon, The (1995)                            0.48861751 0.5303215
Antonia's Line (1995)                                1.00000000 0.3100373
Angels and Insects (1995)                            0.31003735 1.0000000

Mit der erstellten Funktion haben wir für den gesamten MovieLense Datensatz die Cosine Similarity Matrix berechnet. Um das Resultat lesbar darzustellen, zeigen wir hier nur die ersten fünf Item. Bei der Analyse der ersten 20 Items wurde ersichtlich, dass die Werte zwischen 0 und 1 liegen. Negative Similarities sind nicht ersichtlich. Wie mit dir besprochen und hergeleitet, ist das aber verständlich, da aufgrund der nicht-negativen Ratings der maximale Winkel 90° beträgt. Hätten wir mit normierten Ratings gearbeitet, wären auch negative Werte aufgetreten.

4.1.2 Jaccard Similarity

get_jaccardsim_4 <- function(RatingMatrix, n_user, n_item){
  
  sliced_matrix_bin <- as(binarize(RatingMatrix[1:n_user, 1:n_item], minRating=4), "matrix")
  
  sliced_matrix_bin_t <- t(sliced_matrix_bin)
  
  matrix_corssprod <- tcrossprod(sliced_matrix_bin_t)
  
  im <- which(matrix_corssprod > 0, arr.ind=TRUE)
  b <- rowSums(sliced_matrix_bin_t)
  Aim <- matrix_corssprod[im]
  
  J = sparseMatrix(
            i = im[,1],
            j = im[,2],
            x = Aim / (b[im[,1]] + b[im[,2]] - Aim),
            dims = dim(matrix_corssprod)
      )
  
  J <- data.matrix(J)
  
  J
}

get_jaccardsim_4(MovieLense, number_user, number_item)

             [,1]       [,2]       [,3]       [,4]       [,5]       [,6]       [,7]       [,8]       [,9]      [,10]      [,11]      [,12]      [,13]
  [1,] 1.00000000 0.05128205 0.05128205 0.13043478 0.10526316 0.07317073 0.38983051 0.31914894 0.24561404 0.04651163 0.22727273 0.25000000 0.17391304
  [2,] 0.05128205 1.00000000 0.00000000 0.06250000 0.00000000 0.00000000 0.02173913 0.03846154 0.02857143 0.00000000 0.00000000 0.03448276 0.00000000
  [3,] 0.05128205 0.00000000 1.00000000 0.06250000 0.00000000 0.12500000 0.06818182 0.00000000 0.05882353 0.11111111 0.05555556 0.07142857 0.11764706
  [4,] 0.13043478 0.06250000 0.06250000 1.00000000 0.12500000 0.00000000 0.20833333 0.31034483 0.23684211 0.10526316 0.30434783 0.32258065 0.15384615
  [5,] 0.10526316 0.00000000 0.00000000 0.12500000 1.00000000 0.00000000 0.06666667 0.07692308 0.12121212 0.00000000 0.11111111 0.10714286 0.05263158
  [6,] 0.07317073 0.00000000 0.12500000 0.00000000 0.00000000 1.00000000 0.08695652 0.07142857 0.08333333 0.18181818 0.04761905 0.10000000 0.10000000
  [7,] 0.38983051 0.02173913 0.06818182 0.20833333 0.06666667 0.08695652 1.00000000 0.28301887 0.32758621 0.08510638 0.27659574 0.39215686 0.20000000
  [8,] 0.31914894 0.03846154 0.00000000 0.31034483 0.07692308 0.07142857 0.28301887 1.00000000 0.39024390 0.14814815 0.29032258 0.34210526 0.17647059
  [9,] 0.24561404 0.02857143 0.05882353 0.23684211 0.12121212 0.08333333 0.32758621 0.39024390 1.00000000 0.14285714 0.28947368 0.46341463 0.19512195
 [10,] 0.04651163 0.00000000 0.11111111 0.10526316 0.00000000 0.18181818 0.08510638 0.14814815 0.14285714 1.00000000 0.15000000 0.13333333 0.09523810
            [,14]      [,15]      [,16]      [,17]      [,18]      [,19]      [,20]      [,21]      [,22]      [,23]      [,24]      [,25]      [,26]
  [1,] 0.19565217 0.27450980 0.05263158 0.05000000 0.02564103 0.10000000 0.02500000 0.00000000 0.23529412 0.22222222 0.06976744 0.24489796 0.05128205
  [2,] 0.00000000 0.07142857 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.07692308 0.00000000 0.00000000 0.04000000 0.00000000
  [3,] 0.11111111 0.07142857 0.25000000 0.00000000 0.66666667 0.12500000 0.20000000 0.00000000 0.07692308 0.11111111 0.10000000 0.13043478 0.00000000
  [4,] 0.10714286 0.10810811 0.06666667 0.05882353 0.06666667 0.00000000 0.06250000 0.07142857 0.30000000 0.14814815 0.22222222 0.08823529 0.06250000
  [5,] 0.00000000 0.10714286 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.03571429 0.05000000 0.00000000 0.08000000 0.16666667
  [6,] 0.15000000 0.06451613 0.14285714 0.11111111 0.14285714 0.20000000 0.28571429 0.00000000 0.10714286 0.21052632 0.00000000 0.07407407 0.28571429
  [7,] 0.10909091 0.24561404 0.04545455 0.02127660 0.04545455 0.11111111 0.04444444 0.00000000 0.27777778 0.19607843 0.10638298 0.24074074 0.02173913
  [8,] 0.28125000 0.13333333 0.00000000 0.03703704 0.00000000 0.07142857 0.08000000 0.00000000 0.28947368 0.24242424 0.10344828 0.14634146 0.12500000
  [9,] 0.21951220 0.33333333 0.06060606 0.05714286 0.06060606 0.08333333 0.09090909 0.00000000 0.28888889 0.28205128 0.07894737 0.21739130 0.09090909
 [10,] 0.20000000 0.03030303 0.00000000 0.10000000 0.12500000 0.08333333 0.11111111 0.00000000 0.14285714 0.14285714 0.07142857 0.11111111 0.11111111
            [,27]      [,28]      [,29]      [,30]      [,31]      [,32]      [,33] [,34]      [,35] [,36] [,37]      [,38]      [,39]      [,40]
  [1,] 0.00000000 0.32653061 0.02631579 0.00000000 0.18604651 0.13636364 0.05000000     0 0.02631579     0     0 0.02564103 0.05000000 0.05263158
  [2,] 0.16666667 0.07142857 0.00000000 0.00000000 0.06666667 0.00000000 0.00000000     0 0.00000000     0     0 0.66666667 0.00000000 0.00000000
  [3,] 0.00000000 0.07142857 0.00000000 0.20000000 0.00000000 0.15384615 0.16666667     0 0.00000000     0     0 0.00000000 0.40000000 0.00000000
  [4,] 0.12500000 0.20588235 0.00000000 0.06250000 0.17391304 0.23809524 0.12500000     0 0.00000000     0     0 0.06666667 0.20000000 0.06666667
  [5,] 0.00000000 0.06896552 0.00000000 0.00000000 0.13333333 0.00000000 0.00000000     0 0.00000000     0     0 0.00000000 0.00000000 0.00000000
  [6,] 0.00000000 0.03125000 0.00000000 0.12500000 0.05555556 0.05882353 0.25000000     0 0.00000000     0     0 0.00000000 0.11111111 0.00000000
  [7,] 0.06666667 0.24561404 0.00000000 0.04444444 0.21276596 0.19148936 0.04347826     0 0.00000000     0     0 0.02222222 0.09090909 0.02222222
  [8,] 0.12000000 0.27500000 0.00000000 0.03846154 0.23333333 0.16129032 0.07692308     0 0.00000000     0     0 0.04000000 0.07692308 0.00000000
  [9,] 0.08823529 0.25000000 0.00000000 0.09090909 0.17948718 0.21621622 0.08823529     0 0.00000000     0     0 0.02941176 0.12121212 0.02941176
 [10,] 0.22222222 0.13333333 0.00000000 0.25000000 0.17647059 0.11764706 0.10000000     0 0.00000000     0     0 0.00000000 0.22222222 0.00000000
            [,41]      [,42]      [,43]      [,44]      [,45]      [,46]      [,47]      [,48]      [,49]      [,50]      [,51]      [,52]      [,53]
  [1,] 0.00000000 0.20454545 0.05263158 0.05000000 0.12500000 0.05263158 0.06666667 0.20930233 0.07500000 0.43283582 0.12500000 0.14285714 0.04878049
  [2,] 0.00000000 0.00000000 0.25000000 0.00000000 0.00000000 0.00000000 0.00000000 0.13333333 0.14285714 0.03389831 0.00000000 0.00000000 0.00000000
  [3,] 0.00000000 0.20000000 0.25000000 0.40000000 0.25000000 0.25000000 0.18181818 0.13333333 0.00000000 0.03389831 0.25000000 0.18181818 0.14285714
  [4,] 0.00000000 0.16000000 0.00000000 0.12500000 0.10526316 0.06666667 0.26315789 0.21739130 0.26666667 0.20000000 0.16666667 0.20000000 0.18750000
  [5,] 0.00000000 0.05555556 0.00000000 0.00000000 0.10000000 0.20000000 0.07692308 0.12500000 0.12500000 0.05084746 0.22222222 0.07692308 0.00000000
  [6,] 0.00000000 0.10526316 0.14285714 0.11111111 0.18181818 0.14285714 0.06666667 0.11111111 0.00000000 0.06666667 0.08333333 0.23076923 0.00000000
  [7,] 0.02272727 0.22916667 0.02222222 0.09090909 0.08510638 0.04545455 0.17391304 0.16000000 0.08888889 0.43661972 0.10869565 0.12500000 0.11363636
  [8,] 0.04166667 0.18181818 0.00000000 0.03703704 0.10714286 0.04000000 0.17241379 0.22580645 0.16000000 0.30158730 0.14814815 0.21428571 0.07407407
  [9,] 0.03030303 0.20000000 0.02941176 0.08823529 0.17647059 0.06060606 0.22857143 0.27027027 0.08571429 0.35820896 0.17647059 0.19444444 0.11764706
 [10,] 0.00000000 0.10000000 0.00000000 0.22222222 0.07692308 0.00000000 0.13333333 0.10526316 0.00000000 0.10169492 0.07692308 0.21428571 0.20000000
            [,54]      [,55]      [,56]      [,57]      [,58]      [,59]      [,60]      [,61]      [,62]      [,63]      [,64]      [,65]      [,66]
  [1,] 0.05128205 0.11363636 0.32758621 0.04878049 0.16666667 0.11111111 0.04651163 0.09523810 0.07142857 0.05128205 0.35087719 0.09523810 0.12820513
  [2,] 0.20000000 0.07692308 0.02439024 0.00000000 0.07692308 0.00000000 0.00000000 0.00000000 0.11111111 1.00000000 0.07692308 0.00000000 0.50000000
  [3,] 0.20000000 0.16666667 0.05000000 0.14285714 0.16666667 0.15384615 0.25000000 0.22222222 0.00000000 0.00000000 0.05000000 0.22222222 0.12500000
  [4,] 0.13333333 0.25000000 0.26190476 0.00000000 0.25000000 0.18181818 0.10526316 0.15789474 0.16666667 0.06250000 0.26190476 0.15789474 0.17647059
  [5,] 0.00000000 0.07142857 0.07500000 0.00000000 0.15384615 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.10256410 0.09090909 0.11111111
  [6,] 0.00000000 0.06250000 0.09756098 0.37500000 0.13333333 0.28571429 0.44444444 0.27272727 0.00000000 0.00000000 0.09756098 0.27272727 0.09090909
  [7,] 0.04444444 0.22222222 0.45614035 0.04255319 0.10000000 0.16666667 0.08510638 0.13043478 0.08510638 0.02173913 0.40677966 0.10638298 0.08695652
  [8,] 0.03846154 0.20689655 0.40000000 0.11538462 0.20689655 0.20000000 0.10714286 0.14285714 0.10714286 0.03846154 0.43181818 0.18518519 0.11111111
  [9,] 0.05882353 0.22222222 0.46938776 0.11764706 0.22222222 0.21621622 0.14285714 0.17142857 0.02564103 0.02857143 0.44000000 0.17142857 0.11428571
 [10,] 0.11111111 0.05882353 0.12195122 0.20000000 0.12500000 0.11764706 0.16666667 0.07142857 0.00000000 0.00000000 0.12195122 0.15384615 0.00000000
            [,67]      [,68]      [,69]      [,70]      [,71]      [,72]      [,73] [,74]      [,75]      [,76]      [,77]      [,78]      [,79]
  [1,] 0.02564103 0.07317073 0.35416667 0.30434783 0.25000000 0.05000000 0.12195122     0 0.02631579 0.07692308 0.11904762 0.02631579 0.38181818
  [2,] 0.25000000 0.00000000 0.07142857 0.08695652 0.05263158 0.00000000 0.10000000     0 0.00000000 0.00000000 0.20000000 0.00000000 0.07894737
  [3,] 0.00000000 0.12500000 0.03448276 0.00000000 0.00000000 0.16666667 0.10000000     0 0.33333333 0.16666667 0.20000000 0.00000000 0.07894737
  [4,] 0.06666667 0.17647059 0.32258065 0.16129032 0.34782609 0.12500000 0.10000000     0 0.00000000 0.20000000 0.09523810 0.00000000 0.20930233
  [5,] 0.00000000 0.00000000 0.14814815 0.08333333 0.10526316 0.00000000 0.09090909     0 0.00000000 0.00000000 0.08333333 0.00000000 0.07692308
  [6,] 0.00000000 0.09090909 0.00000000 0.12000000 0.04545455 0.11111111 0.00000000     0 0.16666667 0.11111111 0.07142857 0.00000000 0.07317073
  [7,] 0.02222222 0.11111111 0.29090909 0.24528302 0.17307692 0.06666667 0.10638298     0 0.02272727 0.09090909 0.10416667 0.00000000 0.41379310
  [8,] 0.04000000 0.11111111 0.30769231 0.35294118 0.46428571 0.12000000 0.10344828     0 0.00000000 0.12000000 0.06451613 0.00000000 0.37777778
  [9,] 0.02941176 0.08333333 0.30434783 0.34146341 0.28205128 0.08823529 0.13888889     0 0.03030303 0.12121212 0.16666667 0.00000000 0.29090909
 [10,] 0.00000000 0.08333333 0.13333333 0.11538462 0.09090909 0.22222222 0.07142857     0 0.00000000 0.00000000 0.14285714 0.00000000 0.09756098
            [,80]      [,81]      [,82]      [,83]      [,84]      [,85]      [,86]      [,87]      [,88]      [,89]      [,90]      [,91]      [,92]
  [1,] 0.02439024 0.11627907 0.26086957 0.15909091 0.05263158 0.02564103 0.13953488 0.19565217 0.18604651 0.20370370 0.02631579 0.17073171 0.09302326
  [2,] 0.16666667 0.00000000 0.15000000 0.06666667 0.00000000 0.00000000 0.00000000 0.11111111 0.23076923 0.03448276 0.00000000 0.00000000 0.00000000
  [3,] 0.16666667 0.18181818 0.09523810 0.06666667 0.25000000 0.00000000 0.07692308 0.11111111 0.06666667 0.07142857 0.33333333 0.18181818 0.09090909
  [4,] 0.20000000 0.20000000 0.25925926 0.12500000 0.00000000 0.14285714 0.13636364 0.14814815 0.17391304 0.20588235 0.00000000 0.14285714 0.35294118
  [5,] 0.00000000 0.07692308 0.09090909 0.00000000 0.00000000 0.00000000 0.07142857 0.10526316 0.06250000 0.06896552 0.00000000 0.00000000 0.08333333
  [6,] 0.11111111 0.06666667 0.04000000 0.11764706 0.14285714 0.00000000 0.21428571 0.04545455 0.05555556 0.10000000 0.16666667 0.06666667 0.07142857
  [7,] 0.06666667 0.20000000 0.23076923 0.11764706 0.02222222 0.02222222 0.12244898 0.17307692 0.11764706 0.29090909 0.02272727 0.22727273 0.20454545
  [8,] 0.07692308 0.17241379 0.15789474 0.32142857 0.00000000 0.00000000 0.29629630 0.20588235 0.15625000 0.27500000 0.00000000 0.21428571 0.17857143
  [9,] 0.08823529 0.26470588 0.17777778 0.17948718 0.02941176 0.02941176 0.22222222 0.25000000 0.12195122 0.22448980 0.03030303 0.13157895 0.16666667
 [10,] 0.10000000 0.21428571 0.03846154 0.17647059 0.00000000 0.00000000 0.20000000 0.14285714 0.00000000 0.13333333 0.00000000 0.13333333 0.14285714
            [,93]      [,94]      [,95]      [,96]      [,97]      [,98]      [,99]     [,100]
  [1,] 0.09090909 0.10256410 0.30232558 0.26923077 0.18750000 0.40350877 0.23255814 0.43548387
  [2,] 0.00000000 0.33333333 0.10526316 0.06896552 0.10000000 0.02272727 0.05882353 0.01886792
  [3,] 0.08333333 0.00000000 0.05000000 0.06896552 0.04761905 0.07142857 0.05882353 0.03846154
  [4,] 0.20000000 0.05555556 0.10344828 0.27272727 0.26923077 0.24444444 0.20833333 0.20370370
  [5,] 0.07692308 0.00000000 0.10000000 0.10344828 0.09523810 0.06976744 0.05555556 0.07843137
  [6,] 0.14285714 0.00000000 0.09090909 0.09677419 0.08695652 0.09090909 0.05000000 0.09615385
  [7,] 0.20000000 0.06521739 0.19230769 0.35849057 0.14545455 0.45762712 0.15686275 0.53225806
  [8,] 0.09677419 0.07407407 0.23529412 0.30000000 0.34375000 0.37500000 0.30000000 0.33928571
  [9,] 0.13157895 0.02702703 0.18604651 0.27083333 0.30000000 0.38888889 0.20000000 0.44827586
 [10,] 0.06250000 0.00000000 0.08695652 0.12903226 0.13043478 0.11363636 0.15789474 0.11538462
 [ reached getOption("max.print") -- omitted 90 rows ]

Bei der Jaccard Similarity sind wiederum nur positive Werte ersichtlich. Eine Auswertung dieser geplotteten Werte ergibt, dass sehr wenige Werte über 0.3 liegen. Die Ähnlichkeit dieser ersten 10 Filme gegenüber den ersten 100 anderen Items ist also eher gering.

4.2 Vergleiche deine Implementierung der Cosine-basierten

Ähnlichkeitsmatrix für ordinale Ratings mit der via recommenderlab und einem anderen R-Paket erzeugten Ähnlichkeitsmatrix,

4.2.1 Vergleich Cosine Similiarty mit Recommenderlab

#recom_simcosin_4 <- as.matrix(similarity(normalize(MovieLense[1:number_user, 1:number_item]), which = "items", method = "cosine"))
recom_simcosin_4 <- as.matrix(similarity(MovieLense[1:number_user, 1:number_item], which = "items", method = "cosine"))

recom_simcosin_4[1:5,1:5]

                  Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995) Copycat (1995)
Toy Story (1995)                NA        0.9821980         0.9308431         0.9664688      0.9730499
GoldenEye (1995)         0.9821980               NA         0.9455211         0.9598695      0.9629100
Four Rooms (1995)        0.9308431        0.9455211                NA         0.9687050      0.9472136
Get Shorty (1995)        0.9664688        0.9598695         0.9687050                NA      0.9368489
Copycat (1995)           0.9730499        0.9629100         0.9472136         0.9368489             NA

result_cossim_4_scaled <- 1 / 2 * (result_cossim_4 + 1)

result_cossim_4_scaled[1:5,1:5]

5 x 5 Matrix of class "dgeMatrix"
                  Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995) Copycat (1995)
Toy Story (1995)         1.0000000        0.6893027         0.6778574         0.7042896      0.6770326
GoldenEye (1995)         0.6893027        1.0000000         0.5797779         0.7029339      0.6699096
Four Rooms (1995)        0.6778574        0.5797779         1.0000000         0.6994520      0.6142876
Get Shorty (1995)        0.7042896        0.7029339         0.6994520         1.0000000      0.6337300
Copycat (1995)           0.6770326        0.6699096         0.6142876         0.6337300      1.0000000

4.2.2 Vergleich Cosine Similiarity mit anderem R-Paket

library(lsa)

rec_simMat <- similarity(MovieLenseCompact_1[,1:5], which = "items")
rec_simMat

                                    101 Dalmatians (1996) 12 Angry Men (1957) 187 (1997) 2 Days in the Valley (1996)
12 Angry Men (1957)                             0.9491014                                                           
187 (1997)                                      0.9377585           0.9951661                                       
2 Days in the Valley (1996)                     0.9424520           0.9908561  0.9728694                            
20,000 Leagues Under the Sea (1954)             0.9636541           0.9846314  0.9824506                   0.9745629

# simMat_lsa <- cosine(DfforSimMatrix, y = NULL)

4.3 Vergleiche deine mittels Cosine Similarity erzeugten Ähnlichkeitsmatrix für ordinale Ratings mit der Jaccard-basierten Ähnlichkeitsmatrix für binäre Ratings.

5 Analyse Top-N Listen - IBCF vs UBCF

Aufgabe 5: Vergleiche und diskutiere Top-N Empfehlungen von IBCF und UBCF Modellen mit 30 Nachbarn und Cosine Similarity für den reduzierten Datensatz. ## 5.1 Berechne Top-15 Empfehlungen für Testkunden mit IBCF und UBCF ### 5.1.1 ribcf & rubcf Modell trainieren

ribcf_1 <- Recommender(training_1, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_1

Recommender of type ‘IBCF’ for ‘realRatingMatrix’ 
learned using 320 users.

rubcf_1 <- Recommender(training_1, "UBCF", param=list(nn= 30, method = "cosine"))
rubcf_1

Recommender of type ‘UBCF’ for ‘realRatingMatrix’ 
learned using 320 users.

ribcf_2 <- Recommender(training_2, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_2

Recommender of type ‘IBCF’ for ‘realRatingMatrix’ 
learned using 320 users.

rubcf_2 <- Recommender(training_2, "UBCF", param=list(nn= 30, method = "cosine"))
rubcf_2

Recommender of type ‘UBCF’ for ‘realRatingMatrix’ 
learned using 320 users.

Es wurden für beide reduzierten Datensätze jeweils ein ibcf und ubcf Recommender erstellt.

5.1.2 Model Predicitions erstellen

ribcftopNList_1 <- predict(ribcf_1, test_1, n=15)
ribcftopNList_1

Recommendations as ‘topNList’ with n = 15 for 80 users. 

rubcftopNList_1 <- predict(rubcf_1, test_1, n=15)
rubcftopNList_1

Recommendations as ‘topNList’ with n = 15 for 80 users. 

ribcftopNList_2 <- predict(ribcf_2, test_2, n=15)
ribcftopNList_2

Recommendations as ‘topNList’ with n = 15 for 80 users. 

rubcftopNList_2 <- predict(rubcf_2, test_2, n=15)
rubcftopNList_2

Recommendations as ‘topNList’ with n = 15 for 80 users. 

Nun wurden für beide Datensätze Predictions mit n = 15 und für 80 User berechnet.

5.1.3 Ausgabe von einer Prediction

# ausgabe von einem output
as(ribcftopNList_1, "list")[1:5]

$`0`
 [1] "Strictly Ballroom (1992)"                                   "Like Water For Chocolate (Como agua para chocolate) (1992)"
 [3] "Casablanca (1942)"                                          "In the Company of Men (1997)"                              
 [5] "Love Bug, The (1969)"                                       "My Left Foot (1989)"                                       
 [7] "African Queen, The (1951)"                                  "Fantasia (1940)"                                           
 [9] "Fear (1996)"                                                "Sphere (1998)"                                             
[11] "Dial M for Murder (1954)"                                   "Dead Man Walking (1995)"                                   
[13] "Citizen Kane (1941)"                                        "Smoke (1995)"                                              
[15] "What's Eating Gilbert Grape (1993)"                        

$`1`
 [1] "2 Days in the Valley (1996)"          "Adventures of Robin Hood, The (1938)" "Alice in Wonderland (1951)"          
 [4] "American in Paris, An (1951)"         "Being There (1979)"                   "Bringing Up Baby (1938)"             
 [7] "Cinema Paradiso (1988)"               "Crash (1996)"                         "Dead Man Walking (1995)"             
[10] "Ed Wood (1994)"                       "Grand Day Out, A (1992)"              "Hunt for Red October, The (1990)"    
[13] "Jackie Chan's First Strike (1996)"    "Jungle Book, The (1994)"              "Madness of King George, The (1994)"  

$`2`
 [1] "Time to Kill, A (1996)"            "City Hall (1996)"                  "City of Lost Children, The (1995)" "In the Company of Men (1997)"     
 [5] "Independence Day (ID4) (1996)"     "M*A*S*H (1970)"                    "Forrest Gump (1994)"               "Braveheart (1995)"                
 [9] "Dave (1993)"                       "Dead Poets Society (1989)"         "Mr. Holland's Opus (1995)"         "Cool Hand Luke (1967)"            
[13] "In the Line of Fire (1993)"        "Ghost (1990)"                      "Blade Runner (1982)"              

$`3`
 [1] "Bob Roberts (1992)"                           "Clerks (1994)"                                "Cool Hand Luke (1967)"                       
 [4] "Gandhi (1982)"                                "His Girl Friday (1940)"                       "Ice Storm, The (1997)"                       
 [7] "Pink Floyd - The Wall (1982)"                 "Postino, Il (1994)"                           "Rebel Without a Cause (1955)"                
[10] "Willy Wonka and the Chocolate Factory (1971)" "Shine (1996)"                                 "Seven (Se7en) (1995)"                        
[13] "Grosse Pointe Blank (1997)"                   "Three Colors: Red (1994)"                     "Boot, Das (1981)"                            

$`4`
 [1] "Monty Python's Life of Brian (1979)" "Henry V (1989)"                      "As Good As It Gets (1997)"          
 [4] "In the Company of Men (1997)"        "Junior (1994)"                       "Renaissance Man (1994)"             
 [7] "Cinema Paradiso (1988)"              "Dumbo (1941)"                        "White Squall (1996)"                
[10] "Boot, Das (1981)"                    "Strictly Ballroom (1992)"            "When Harry Met Sally... (1989)"     
[13] "Forbidden Planet (1956)"             "Amadeus (1984)"                      "American in Paris, An (1951)"       

Dies ist eine Übersicht der Empfehlungen für die ersten 5 User. Wie erfordert, wurden jeweils 15 Empfehlungen generiert. Auf den ersten Blick werden viele unterschiedlichen Filme empfohlen.

5.2 Vergleiche die Top-15 Empfehlungen und deren Verteilung und diskutiere Gemeinsamkeiten und Unterschiede zwischen IBCF und UBCF für alle Testkunden.

# df funktion erstellen
topN_df <- function(topNList){
  counts <- table(unlist(as.array(as(topNList, "list"))))
  df <- data.frame(Movie = names(counts), Count = unname(counts)) %>%
    select("Movie", "Count.Freq") %>%
    rename("Count" = "Count.Freq") %>%
    arrange(desc(Count))  
  df
}

# alle dfs erstellen
ribcftopN_df_1 <- topN_df(ribcftopNList_1)
ribcftopN_df_1

ribcftopN_df_2 <- topN_df(ribcftopNList_2)
ribcftopN_df_2

rubcftopN_df_1 <- topN_df(rubcftopNList_1)
rubcftopN_df_1

rubcftopN_df_2 <- topN_df(rubcftopNList_2)
rubcftopN_df_2

NA

Die ersten beiden Tabellen stellen die Empfehlungen und deren Anzahl basierend auf IBCF für die beiden Datensätze dar. In den Top 10 Empfehlungen sind sehr unterschiedliche Empfehlungen, es gibt kaum Überschneidungen. Für den ersten Datensatz wird ein Film maximal 11 mal, im zweiten maximal 15 mal empfohlen. Beim ersten Datensatz werden insgesamt 487 Filme und beim zweiten 407 empfohlen.

Die letzten beiden Tabellen stellen die Empfehlungen basierend auf UBCF für die beiden Datensätze dar. Die Top 10 Filme sind wieder sehr unterschiedlich. Grosse Unterschiede gibt es auch bei der Anzahl Vorkommen der Top Filme. Für den ersten Datensatz werden sie bis zu 30 mal empfohlen, während es beim zweiten maximal 14 mal war. Auch liegt die Anzahl Empfehlungen mit 301 vs 392 weit auseinander.

Für weitere Informationen visualisieren wir nun auch die Top Empfehlungen.

5.2.1 Verteilungen visualisieren

# funktion zur Visualisierung
top15_df_visualize <- function(topNList, subtitle){
  topNList %>% head(15) %>% 
    ggplot(aes(x = reorder(Movie, Count), y = Count)) +
    geom_bar(stat = "identity", fill = "limegreen", alpha = 0.5, color = "black") +
    coord_flip() +
    labs(x = "Movie", 
         y = "Anzahl", 
         title = "Top-15 Empfehlungen",
         subtitle = subtitle)
}

grid.arrange(top15_df_visualize(ribcftopN_df_1, "ribcf 1"),
             top15_df_visualize(rubcftopN_df_1, "rubcf 1"),
             ncol = 2)

grid.arrange(top15_df_visualize(ribcftopN_df_2, "ribcf 2"),
             top15_df_visualize(rubcftopN_df_2, "rubcf 2"),
             ncol = 2)

Dank der library gridExtra können wir die beiden Datensätze nebeneinander darstellen. Ersichtlich wird, wie schnell die Anzahl Empfehlungen pro Film abnimmt. In der ersten Lasche, IBCF, sieht man, dass die Anzahl linear abnimmt, nachdem die ersten fünf Filme gleich häufig empfohlen werden. Hingegen nehmen die Anzahl im zweiten Datensatz (Grafik rechts) zuerst schnell, bis etwa zum Niveau des ersten Datensatzes, dann linear ab. Bei UBCF, in der zweiten Lasche, nimmt die Anzahl bei beiden Datensätzen linear ab.

Die erwähnte Behauptung “Recommender Systeme machen für alle Nutzer die gleichen Empfehlungen” kann dank der Tabellen und Histogramme verworfen werden. Es werden viele unterschiedliche Filme empfohlen, vieleviele Filme werden nur wenigen Usern (<4) empfohlen.

6 Analyse Top-N Listen - Ratings

Aufgabe 6: Untersuche den Einfluss von Ratings (ordinale vs binäre Ratings) und Modelltyp (IBCF vs UBCF) auf Top-N Empfehlungen für den reduzierten Datensatz. Vergleiche den Anteil übereinstimmender Empfehlungen der Top-15 Liste für ## 6.1 IBCF vs UBCF, beide mit ordinalem Rating und Cosine Similarity für alle Testkunden,

compare_ibcf_ubcf <- function(ibcf, ubcf) {
  print(paste("Anzahl IBCF:", nrow(ibcf)))
  print(paste("Anzahl UBCF:", nrow(ubcf)))

  IntersectordRatCosine <- intersect(ibcf$Movie, ubcf$Movie)

  print(paste("Anzahl gemeinsame Empfehlungen:", length(IntersectordRatCosine)))
  print(paste("Anteil IBCF:", length(IntersectordRatCosine) / nrow(ibcf) * 100))
  print(paste("Anteil UBCF:", length(IntersectordRatCosine) / nrow(ubcf) * 100))
}

print("Erste Datenreduktion")

[1] "Erste Datenreduktion"

compare_ibcf_ubcf(ribcftopN_df_1, rubcftopN_df_1)

[1] "Anzahl IBCF: 487"
[1] "Anzahl UBCF: 301"
[1] "Anzahl gemeinsame Empfehlungen: 231"
[1] "Anteil IBCF: 47.4332648870637"
[1] "Anteil UBCF: 76.7441860465116"

print("Zweite Datenreduktion")

[1] "Zweite Datenreduktion"

compare_ibcf_ubcf(ribcftopN_df_2, rubcftopN_df_2)

[1] "Anzahl IBCF: 407"
[1] "Anzahl UBCF: 392"
[1] "Anzahl gemeinsame Empfehlungen: 226"
[1] "Anteil IBCF: 55.5282555282555"
[1] "Anteil UBCF: 57.6530612244898"

Erste Datenreduktion: Für IBCF werden 487 und UBCF 301 Filme empfohlen, dabei gibt es eine Übereinstimmung von 231 Filmen. Das entsprechen bei IBCF 47.5% und bei UBCF 76.7%. Zweite Datenreduktion: Für IBCF werden 407 und UBCF 392 Filme empfohlen, dabei gibt es eine Übereinstimmung von 226 Filmen. Das entsprechen bei IBCF 55% und bei UBCF 57%.

Insgesamt generieren also beide Methoden ähnliche Empfehlungen, rund die Hälfte bis 3/4 der Empfehlungen generiert auch die andere Methode. Auffällig ist hingegen beim ersten Datensatz, dass IBCF viel mehr Filme empfiehlt, während es beim zweiten etwa gleich viel sind.

Beim zweiten Datensatz ist auch der Anteil an Gemeinsamkeiten jeweils bei rund 55% und damit ausgeglichener als im ersten Datensatz. Ich kann mir vorstellen, dass das daran liegt, dass beim zweiten Datensatz die Sparsity der Matrix höher ist und damit mehr Spielraum offen ist.

6.2 IBCF vs UBCF, beide mit binärem Rating und Jaccard Similarity für alle Testkunden,

training_bin_1 <- binarize(training_1, minRating = 4)
test_bin_1 <- binarize(test_1, minRating = 4)

training_bin_2 <- binarize(training_2, minRating = 4)
test_bin_2 <- binarize(test_2, minRating = 4)

ribcf_bin_1 <- Recommender(training_bin_1, "IBCF", param=list(k= 30, method = "jaccard"))
ribcf_bin_1

Recommender of type ‘IBCF’ for ‘binaryRatingMatrix’ 
learned using 320 users.

rubcf_bin_1 <- Recommender(training_bin_1, "UBCF", param=list(nn= 30, method = "jaccard"))
rubcf_bin_1

Recommender of type ‘UBCF’ for ‘binaryRatingMatrix’ 
learned using 320 users.

ribcf_bin_2 <- Recommender(training_bin_2, "IBCF", param=list(k= 30, method = "jaccard"))
ribcf_bin_2

Recommender of type ‘IBCF’ for ‘binaryRatingMatrix’ 
learned using 320 users.

rubcf_bin_2 <- Recommender(training_bin_2, "UBCF", param=list(nn= 30, method = "jaccard"))
rubcf_bin_2

Recommender of type ‘UBCF’ for ‘binaryRatingMatrix’ 
learned using 320 users.

ribcftopNList_bin_1 = predict(ribcf_bin_1, test_bin_1, n=15)
ribcftopNList_bin_1

Recommendations as ‘topNList’ with n = 15 for 80 users. 

rubcftopNList_bin_1 = predict(rubcf_bin_1, test_bin_1, n=15)
rubcftopNList_bin_1

Recommendations as ‘topNList’ with n = 15 for 80 users. 

ribcftopNList_bin_2 = predict(ribcf_bin_2, test_bin_2, n=15)
ribcftopNList_bin_2

Recommendations as ‘topNList’ with n = 15 for 80 users. 

rubcftopNList_bin_2 = predict(rubcf_bin_2, test_bin_2, n=15)
rubcftopNList_bin_2

Recommendations as ‘topNList’ with n = 15 for 80 users. 

ribcftopN_df_bin_1 <- topN_df(ribcftopNList_bin_1)
ribcftopN_df_bin_1

ribcftopN_df_bin_2 <- topN_df(ribcftopNList_bin_2)
ribcftopN_df_bin_2

rubcftopN_df_bin_1 <- topN_df(rubcftopNList_bin_1)
rubcftopN_df_bin_1

rubcftopN_df_bin_2 <- topN_df(rubcftopNList_bin_2)
rubcftopN_df_bin_2

NA

Diese Auswertung entspricht der, der vorherigen Aufgabe, nur dass dieses mal mit binären Ratings und Jaccard Similarity gearbeitet wurde. Es wird auch hier ersichtlich, dass die Empfehlungen sehr unterschiedlich sind. Bei IBCF (erste zwei Tabellen) werden für den ersten Datensatz die Top Filme sehr viel häufiger (39 mal vs 16 mal) empfohlen. Das gleiche Muster, wenn aber schwächer, ist bei den UBCF ersichtlich.

print("Erste Datenreduktion binaer")

[1] "Erste Datenreduktion binaer"

compare_ibcf_ubcf(ribcftopN_df_bin_1, rubcftopN_df_bin_1)

[1] "Anzahl IBCF: 87"
[1] "Anzahl UBCF: 447"
[1] "Anzahl gemeinsame Empfehlungen: 6"
[1] "Anteil IBCF: 6.89655172413793"
[1] "Anteil UBCF: 1.34228187919463"

print("Zweite Datenreduktion binaer")

[1] "Zweite Datenreduktion binaer"

compare_ibcf_ubcf(ribcftopN_df_bin_2, rubcftopN_df_bin_2)

[1] "Anzahl IBCF: 411"
[1] "Anzahl UBCF: 519"
[1] "Anzahl gemeinsame Empfehlungen: 296"
[1] "Anteil IBCF: 72.0194647201946"
[1] "Anteil UBCF: 57.0327552986513"

Im Gegensatz zur vorherigen Aufgabe und den zweiten Datensatz, gibt es für den ersten fast keine gemeinsame Empfehlungen. Es fällt auch auf, dass für IBCF nur 87 Filme empfohlen werden. Diese Auswertung wurde mit minRating 4 für die binäre Klassifizierung berechnet. Mit Rating 3 sieht dieser Sachverhalt ähnlich aus, bei minRating 5 ist die Übereinstimmung aber wieder im normalen Bereich. Wieso minRating 3 und 4 so tiefe Übereinstimmungen generiert haben, können wir nicht nachvollziehe. Dass minRating 5 aber bessere Resultate generiert, liegt daran, dass nun nur noch wenige Items als 1 klassifiziert werden und damit weniger Filme zur Empfehlung zur Verfügung stellen.

6.3 UBCF mit ordinalem (Cosine Similarity) vs UBCF mit binärem Rating (Jaccard Similarity) für alle Testkunden.

compare_ubcf <- function(ibcf, ubcf) {
  print(paste("Anzahl UBCF ord:", nrow(ibcf)))
  print(paste("Anzahl UBCF bin:", nrow(ubcf)))

  IntersectordRatCosine <- intersect(ibcf$Movie, ubcf$Movie)

  print(paste("Anzahl gemeinsame Empfehlungen:", length(IntersectordRatCosine)))
  print(paste("Anteil UBCF ord:", length(IntersectordRatCosine) / nrow(ibcf) * 100))
  print(paste("Anteil UBCF bin:", length(IntersectordRatCosine) / nrow(ubcf) * 100))
}

Erstellung der Funktion und Berechnung des Resultats

print("Erste Datenreduktion")

[1] "Erste Datenreduktion"

compare_ubcf(rubcftopN_df_1, rubcftopN_df_bin_1)

[1] "Anzahl UBCF ord: 301"
[1] "Anzahl UBCF bin: 447"
[1] "Anzahl gemeinsame Empfehlungen: 207"
[1] "Anteil UBCF ord: 68.7707641196013"
[1] "Anteil UBCF bin: 46.3087248322148"

print("Zweite Datenreduktion")

[1] "Zweite Datenreduktion"

compare_ubcf(rubcftopN_df_2, rubcftopN_df_bin_2)

[1] "Anzahl UBCF ord: 392"
[1] "Anzahl UBCF bin: 519"
[1] "Anzahl gemeinsame Empfehlungen: 301"
[1] "Anteil UBCF ord: 76.7857142857143"
[1] "Anteil UBCF bin: 57.9961464354528"

Beim Vergleich von UBCF mit ordinalem und binärem Rating werden wieder mehr übereinstimmende Filme empfohlen. Für den ersten Datensatz werden 207 Filme bei beiden Modellen und beim zweiten Datensatz 301 übereinstimmende Filme empfohlen. Da bei beiden Datensätzen mit ordinalem Rating weniger Empfehlungen generiert werden, ist der Anteil Übereinstimmungen bei ordinalen Ratings entsprechend höher.

7 Analyse Top-N Listen - IBCF vs SVD

Aufgabe 7: Vergleiche Memory-based IBCF und Modell-based SVD Recommenders bezüglich Überschneidung ihrer Top-N Empfehlungen für die User-Item Matrix des reduzierten Datensatzes (Basis: reduzierter Datensatz, IBCF mit 30 Nachbarn und Cosine Similarity). Vergleiche wie sich der Anteil übereinstimmender Empfehlungen der Top-15 Liste für IBCF vs verschiedene SVD Modelle verändert, wenn die Anzahl der Singulärwerte für SVD von 10 auf 20, 30, 40, 50 verändert wird.

# Funktion fuer SVD Model
generate_SVD_topN_recomm <- function(train, test, svd_value = ksvd){
    recom_model <- Recommender(train, "SVD", param=list(k= svd_value))
    top_n_recom <- predict(recom_model, test, n=15)
  top_n_recom
}

# Funktion fuer verschiedene N
generate_SVD_topN_lists <- function(train, test, N_values) {
  rsvd_topN_lists <- list()
  for (i in 1:length(N_values)) {
    N <- N_values[i]
    list_name <- paste0("rsvd", N, "topNList")
    rsvd_topN_lists[[list_name]] <- generate_SVD_topN_recomm(train, test, N)
  }
  rsvd_topN_lists
}

Funktion zur Berechnung des Resultats

N_values <- c(10, 20, 30, 40, 50)
rsvd_topN_lists_1 <- generate_SVD_topN_lists(training_1, test_1, N_values)
print("Erster Datensatz")

[1] "Erster Datensatz"

rsvd_topN_lists_1

$rsvd10topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd20topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd30topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd40topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd50topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

rsvd_topN_lists_2 <- generate_SVD_topN_lists(training_2, test_2, N_values)
print("Zweiter Datensatz")

[1] "Zweiter Datensatz"

rsvd_topN_lists_2

$rsvd10topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd20topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd30topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd40topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

$rsvd50topNList
Recommendations as ‘topNList’ with n = 15 for 80 users. 

generate_topN_dfs <- function(rsvd_topN_lists) {
  topN_dfs <- list()
  
  for (i in 1:length(rsvd_topN_lists)) {
    list_name <- names(rsvd_topN_lists)[i]
    df_name <- paste0(list_name, "_df")
    topN_dfs[[df_name]] <- topN_df(rsvd_topN_lists[[i]])
  }
  
  topN_dfs
}

topN_df_svd_1 <- generate_topN_dfs(rsvd_topN_lists_1)
print("Erster Datensatz")

[1] "Erster Datensatz"

topN_df_svd_1

$rsvd10topNList_df

$rsvd20topNList_df

$rsvd30topNList_df

$rsvd40topNList_df

$rsvd50topNList_df

topN_df_svd_2 <- generate_topN_dfs(rsvd_topN_lists_2)
print("Zweiter Datensatz")

[1] "Zweiter Datensatz"

topN_df_svd_2

$rsvd10topNList_df

$rsvd20topNList_df

$rsvd30topNList_df

$rsvd40topNList_df

$rsvd50topNList_df

NA

Die ersten fünf Tabellen sind die Resultate für den ersten Datensatz. Es handelt sich aufsteigend um die Anzahl Singulärwerte von 10 bis 50. Die letzten fünf Tabellen beinhalten das gleiche Resultat, einfach für den zweiten Datensatz. Diese Auswertung wird noch nicht für die Beantwortung der Aufgabe verwendet, sondern gab uns einen ersten Überblick über die Resultate

compare_ibcf_svd <- function(ribcf, svd, svd_value) {
  intersect <- intersect(ribcf$Movie, svd$Movie)
  print(paste("Anzahl gemeinsame Empfehlungen SVD", svd_value, ":", length(intersect)))
  print(paste("Gemeinsamer relativer Anteil für Anzahl Singulärwerte", svd_value, ":", length(intersect) / nrow(ribcf) * 100))
}

print("Erster Datensatz")

[1] "Erster Datensatz"

compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd10topNList_df, 10)

[1] "Anzahl gemeinsame Empfehlungen SVD 10 : 76"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 10 : 15.605749486653"

compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd20topNList_df, 20)

[1] "Anzahl gemeinsame Empfehlungen SVD 20 : 86"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 20 : 17.6591375770021"

compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd30topNList_df, 30)

[1] "Anzahl gemeinsame Empfehlungen SVD 30 : 93"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 30 : 19.0965092402464"

compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd40topNList_df, 40)

[1] "Anzahl gemeinsame Empfehlungen SVD 40 : 105"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 40 : 21.5605749486653"

compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd50topNList_df, 50)

[1] "Anzahl gemeinsame Empfehlungen SVD 50 : 117"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 50 : 24.0246406570842"

print("Zweiter Datensatz")

[1] "Zweiter Datensatz"

compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd10topNList_df, 10)

[1] "Anzahl gemeinsame Empfehlungen SVD 10 : 10"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 10 : 2.45700245700246"

compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd20topNList_df, 20)

[1] "Anzahl gemeinsame Empfehlungen SVD 20 : 20"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 20 : 4.91400491400491"

compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd30topNList_df, 30)

[1] "Anzahl gemeinsame Empfehlungen SVD 30 : 24"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 30 : 5.8968058968059"

compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd40topNList_df, 40)

[1] "Anzahl gemeinsame Empfehlungen SVD 40 : 27"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 40 : 6.63390663390663"

compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd50topNList_df, 50)

[1] "Anzahl gemeinsame Empfehlungen SVD 50 : 27"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 50 : 6.63390663390663"

Für den ersten Datensatz werden bei SVD Wert 10 76 gemeinsame Empfehlungen mit IBCF generiert. Dies entspricht einem Anteil von 15.6% der Empfehlungen vom SVD Modell. Bis zur Anzahl von 50 Singulärwerten steigt die Anzahl gemeinsamer Empfehlungen auf 117, was einem Anteil von 24% entspricht.

8 Implementierung Top-N Metriken

Aufgabe 8 (DIY) ## 8.1 CoverageN

ribcf_8 <- Recommender(MovieLense, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_8

ribcftopNList_8 <- predict(ribcf_8, MovieLense, n=15)
ribcftopNList_8

list_items_8 <- unique(unlist(as(ribcftopNList_8, "list"), use.names = FALSE))
len_items_8 <- length(list_items_8)

len_all_items_8 <- dim(MovieLense)[2]
len_all_items_8

coverageN <- len_items_8 / len_all_items_8
coverageN

41.7 % der vorhandenen Filme werden empfohlen.

8.2 NoveltyN

nratings(MovieLense) / len_all_items_8

9 Wahl des optimalen Recommenders

Aufgabe 9 ## 9.1 Verwende für die Evaluierung 10-fache Kreuzvalidierung

set.seed(1234)
scheme_1 <- evaluationScheme(MovieLenseCompact_1, method="cross-validation", k = 10, given=3, goodRating=5)
scheme_2 <- evaluationScheme(MovieLenseCompact_2, method="cross-validation", k = 10, given=3, goodRating=5)

print("Erste Datenreduktion")
scheme_1
print("Zweite Datenreduktion")
scheme_2

9.2 Begründe deine Wahl von Metriken und Modell

algorithms <- list("hybrid" = list(name = "HYBRID", param =list(recommenders = list(SVD = list(name="SVD", param=list(k = 40)),
                                                                                    POPULAR = list(name = "POPULAR", param = NULL)
                                                                                    ))),
                   "libmf" = list(name="LIBMF", param=list(dim=10)),
                   "popular items" = list(name="POPULAR", param=NULL),
                   "user-based CF" = list(name="UBCF", param=list(nn=50)),
                   "item-based CF" = list(name="IBCF", param=list(k=50)),
                   "SVD40" = list(name="SVD", param=list(k = 40)))

print("Erster Datensatz")
results_1 <- evaluate(scheme_1, algorithms, type = "topNList", n=c(10, 15, 20, 25, 30))
print("Zweiter Datensatz")
results_2 <- evaluate(scheme_2, algorithms, type = "topNList", n=c(10, 15, 20, 25, 30))

plot(results_1, annotate=c(1,3), legend="topleft")
plot(results_2, annotate=c(1,3), legend="topleft")

9.3 Analysiere das beste Modell für Top-N Recommendations mit N = 10, 15, 20, 25 und 30,

vieles blabaalabaaassss

9.4 Optimiere dein bestes Modell hinsichtlich Hyperparametern

algorithmsimprovedrecom <- list("popular items center" = list(name="POPULAR", param=NULL),
                   "popular items Z-score" = list(name="POPULAR", param=list(normalize="Z-score")))

resultsimprovedrecom_1 <- evaluate(scheme_1, algorithmsimprovedrecom, type = "topNList", n=c(10, 15, 20, 25, 30))
resultsimprovedrecom_2 <- evaluate(scheme_2, algorithmsimprovedrecom, type = "topNList", n=c(10, 15, 20, 25, 30))

plot(resultsimprovedrecom_1, annotate=c(1,3), legend="topleft")
plot(resultsimprovedrecom_2, annotate=c(1,3), legend="topleft")

Hinweis: Verwende für den Top-Movie Recommender die Filme mit den höchsten Durchschnittsratings. # 10 Implementierung Top-N Monitor Aufgabe 10 (DIY): Untersuche die relative Übereinstimmung zwischen Top-N Empfehlungen und präferierten Filmen für 4 unterschiedliche Modelle (z.B. IBCF und UBCF mit unterschiedlichen Ähnlichkeitsmetriken / Nachbarschaften sowie SVD mit unterschiedlicher Dimensionalitätsreduktion).

10.1 Fixiere 20 zufällig gewählte Testkunden für alle Modellvergleiche,

# select 20 random users
set.seed(1234)
testUsers <- sample(1:nrow(MovieLense), 20)
testUsers

# filter MovieLense by testUsers
MovieLenseTest <- MovieLense[testUsers,] 
MovieLenseTest

10.2 Bestimme den Anteil der Top-N Empfehlung nach Genres pro Kunde,

# get from every TestUsers the Top_N item list
ribcf_10 <- Recommender(MovieLenseTest, "IBCF", param=list(k= 30, method = "cosine"))

# predict Top-N items for every user
ribcftopNList_10 <- predict(ribcf_10, MovieLenseTest, n=15)

# create a list with the topN items for every user
ribcftopNList_10_list <- as(ribcftopNList_10, "list")

# create a tibble with the topN items for every user
ribcftopNList_10_tibble <- as_tibble(ribcftopNList_10_list)

# transform the tibble to a data frame
ribcftopNList_10_df <- as.data.frame(ribcftopNList_10_tibble)

# replace colname with testUsers
colnames(ribcftopNList_10_df) <- testUsers

# transpose data frame
ribcftopNList_10_df_transposed <- t(ribcftopNList_10_df)

# change ribcftopNList_10_df_transposed to a tibble
ribcftopNList_10_df_transposed_tibble <- as_tibble(ribcftopNList_10_df_transposed)

# add a column with the testUsers
ribcftopNList_10_df_transposed_tibble$testUsers <- testUsers

# pivot longer dataframe
ribcftopNList_10_df_transposed_tibble_pivot <- pivot_longer(ribcftopNList_10_df_transposed_tibble, cols = 1:15, names_to = "topN", values_to = "itemID")

# get genre from each item
ribcftopNList_10_df_transposed_tibble_pivot_genre <- left_join(ribcftopNList_10_df_transposed_tibble_pivot, MovieLenseMeta, by = c("itemID" = "title"))
ribcftopNList_10_df_transposed_tibble_pivot_genre

# drop columns topN, year, url
ribcftopNList_10_df_transposed_tibble_pivot_genre <- select(ribcftopNList_10_df_transposed_tibble_pivot_genre, -topN, -year, -url, -itemID)
ribcftopNList_10_df_transposed_tibble_pivot_genre

# pivot longer dataframe
ribcftopNList_10_df_transposed_tibble_pivot_genre %>% group_by(testUsers) %>%
  summarise(across(everything(), ~ sum(., is.na(.), 0)))

10.3 Bestimme pro Kunde den Anteil nach Genres seiner Top-Filme

(=Filme mit besten Bewertungen),

10.4 Vergleiche pro Kunde Top-Empfehlungen vs Top-Filme nach Genres,

10.5 Definiere eine Qualitätsmetrik für Top-N Listen und teste sie.